home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / w3 / md5.el.z / md5.el
Encoding:
Text File  |  1998-05-21  |  16.2 KB  |  407 lines
  1. ;;; md5.el -- MD5 Message Digest Algorithm
  2. ;;; Gareth Rees <gdr11@cl.cam.ac.uk>
  3.  
  4. ;; LCD Archive Entry:
  5. ;; md5|Gareth Rees|gdr11@cl.cam.ac.uk|
  6. ;; MD5 cryptographic message digest algorithm|
  7. ;; 13-Nov-95|1.0|~/misc/md5.el.Z|
  8.  
  9. ;;; Details: ------------------------------------------------------------------
  10.  
  11. ;; This is a direct translation into Emacs LISP of the reference C
  12. ;; implementation of the MD5 Message-Digest Algorithm written by RSA
  13. ;; Data Security, Inc.
  14. ;; 
  15. ;; The algorithm takes a message (that is, a string of bytes) and
  16. ;; computes a 16-byte checksum or "digest" for the message.  This digest
  17. ;; is supposed to be cryptographically strong in the sense that if you
  18. ;; are given a 16-byte digest D, then there is no easier way to
  19. ;; construct a message whose digest is D than to exhaustively search the
  20. ;; space of messages.  However, the robustness of the algorithm has not
  21. ;; been proven, and a similar algorithm (MD4) was shown to be unsound,
  22. ;; so treat with caution!
  23. ;; 
  24. ;; The C algorithm uses 32-bit integers; because GNU Emacs
  25. ;; implementations provide 28-bit integers (with 24-bit integers on
  26. ;; versions prior to 19.29), the code represents a 32-bit integer as the
  27. ;; cons of two 16-bit integers.  The most significant word is stored in
  28. ;; the car and the least significant in the cdr.  The algorithm requires
  29. ;; at least 17 bits of integer representation in order to represent the
  30. ;; carry from a 16-bit addition.
  31.  
  32. ;;; Usage: --------------------------------------------------------------------
  33.  
  34. ;; To compute the MD5 Message Digest for a message M (represented as a
  35. ;; string or as a vector of bytes), call
  36. ;; 
  37. ;;   (md5-encode M)
  38. ;; 
  39. ;; which returns the message digest as a vector of 16 bytes.  If you
  40. ;; need to supply the message in pieces M1, M2, ... Mn, then call
  41. ;; 
  42. ;;   (md5-init)
  43. ;;   (md5-update M1)
  44. ;;   (md5-update M2)
  45. ;;   ...
  46. ;;   (md5-update Mn)
  47. ;;   (md5-final)
  48.  
  49. ;;; Copyright and licence: ----------------------------------------------------
  50.  
  51. ;; Copyright (C) 1995, 1996, 1997 by Gareth Rees
  52. ;; Derived from the RSA Data Security, Inc. MD5 Message-Digest Algorithm
  53. ;; 
  54. ;; md5.el is free software; you can redistribute it and/or modify it
  55. ;; under the terms of the GNU General Public License as published by the
  56. ;; Free Software Foundation; either version 2, or (at your option) any
  57. ;; later version.
  58. ;; 
  59. ;; md5.el is distributed in the hope that it will be useful, but WITHOUT
  60. ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  61. ;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  62. ;; for more details.
  63. ;; 
  64. ;; The original copyright notice is given below, as required by the
  65. ;; licence for the original code.  This code is distributed under *both*
  66. ;; RSA's original licence and the GNU General Public Licence.  (There
  67. ;; should be no problems, as the former is more liberal than the
  68. ;; latter).
  69.  
  70. ;;; Original copyright notice: ------------------------------------------------
  71.  
  72. ;; Copyright (C) 1990, RSA Data Security, Inc. All rights reserved.
  73. ;;
  74. ;; License to copy and use this software is granted provided that it is
  75. ;; identified as the "RSA Data Security, Inc. MD5 Message- Digest
  76. ;; Algorithm" in all material mentioning or referencing this software or
  77. ;; this function.
  78. ;;
  79. ;; License is also granted to make and use derivative works provided
  80. ;; that such works are identified as "derived from the RSA Data
  81. ;; Security, Inc. MD5 Message-Digest Algorithm" in all material
  82. ;; mentioning or referencing the derived work.
  83. ;;
  84. ;; RSA Data Security, Inc. makes no representations concerning either
  85. ;; the merchantability of this software or the suitability of this
  86. ;; software for any particular purpose.  It is provided "as is" without
  87. ;; express or implied warranty of any kind.
  88. ;;
  89. ;; These notices must be retained in any copies of any part of this
  90. ;; documentation and/or software.
  91.  
  92. ;;; Code: ---------------------------------------------------------------------
  93.  
  94. (defvar md5-program "md5"
  95.   "*Program that reads a message on its standard input and writes an
  96. MD5 digest on its output.")
  97.  
  98. (defvar md5-maximum-internal-length 4096
  99.   "*The maximum size of a piece of data that should use the MD5 routines
  100. written in lisp.  If a message exceeds this, it will be run through an
  101. external filter for processing.  Also see the `md5-program' variable.
  102. This variable has no effect if you call the md5-init|update|final
  103. functions - only used by the `md5' function's simpler interface.")
  104.  
  105. (defvar md5-bits (make-vector 4 0)
  106.   "Number of bits handled, modulo 2^64.
  107. Represented as four 16-bit numbers, least significant first.")
  108. (defvar md5-buffer (make-vector 4 '(0 . 0))
  109.   "Scratch buffer (four 32-bit integers).")
  110. (defvar md5-input (make-vector 64 0)
  111.   "Input buffer (64 bytes).")
  112.  
  113. (defun md5-unhex (x)
  114.   (if (> x ?9)
  115.       (if (>= x ?a)
  116.       (+ 10 (- x ?a))
  117.     (+ 10 (- x ?A)))
  118.     (- x ?0)))
  119.  
  120. (defun md5-encode (message)
  121.   "Encodes MESSAGE using the MD5 message digest algorithm.
  122. MESSAGE must be a string or an array of bytes.
  123. Returns a vector of 16 bytes containing the message digest."
  124.   (if (<= (length message) md5-maximum-internal-length)
  125.       (progn
  126.     (md5-init)
  127.     (md5-update message)
  128.     (md5-final))
  129.     (save-excursion
  130.       (set-buffer (get-buffer-create " *md5-work*"))
  131.       (erase-buffer)
  132.       (insert message)
  133.       (call-process-region (point-min) (point-max)
  134.                md5-program
  135.                t (current-buffer))
  136.       ;; MD5 digest is 32 chars long
  137.       ;; mddriver adds a newline to make neaten output for tty
  138.       ;; viewing, make sure we leave it behind.
  139.       (let ((data (buffer-substring (point-min) (+ (point-min) 32)))
  140.         (vec (make-vector 16 0))
  141.         (ctr 0))
  142.     (while (< ctr 16)
  143.       (aset vec ctr (+ (* 16 (md5-unhex (aref data (* ctr 2))))
  144.                (md5-unhex (aref data (1+ (* ctr 2))))))
  145.       (setq ctr (1+ ctr)))))))
  146.  
  147. (defsubst md5-add (x y)
  148.   "Return 32-bit sum of 32-bit integers X and Y."
  149.   (let ((m (+ (car x) (car y)))
  150.         (l (+ (cdr x) (cdr y))))
  151.     (cons (logand 65535 (+ m (lsh l -16))) (logand l 65535))))
  152.  
  153. ;; FF, GG, HH and II are basic MD5 functions, providing transformations
  154. ;; for rounds 1, 2, 3 and 4 respectively.  Each function follows this
  155. ;; pattern of computation (where ROTATE(x,y) means rotate 32-bit value x
  156. ;; by y bits to the left):
  157. ;; 
  158. ;;   FF(a,b,c,d,x,s,ac) = ROTATE(a + F(b,c,d) + x + ac,s) + b
  159. ;; 
  160. ;; so we use the macro `md5-make-step' to construct each one.  The
  161. ;; helper functions F, G, H and I operate on 16-bit numbers; the full
  162. ;; operation splits its inputs, operates on the halves separately and
  163. ;; then puts the results together.
  164.  
  165. (defsubst md5-F (x y z) (logior (logand x y) (logand (lognot x) z)))
  166. (defsubst md5-G (x y z) (logior (logand x z) (logand y (lognot z))))
  167. (defsubst md5-H (x y z) (logxor x y z))
  168. (defsubst md5-I (x y z) (logxor y (logior x (logand 65535 (lognot z)))))
  169.  
  170. (defmacro md5-make-step (name func)
  171.   (`
  172.    (defun (, name) (a b c d x s ac)
  173.      (let*
  174.          ((m1 (+ (car a) ((, func) (car b) (car c) (car d)) (car x) (car ac)))
  175.           (l1 (+ (cdr a) ((, func) (cdr b) (cdr c) (cdr d)) (cdr x) (cdr ac)))
  176.           (m2 (logand 65535 (+ m1 (lsh l1 -16))))
  177.           (l2 (logand 65535 l1))
  178.           (m3 (logand 65535 (if (> s 15)
  179.                                 (+ (lsh m2 (- s 32)) (lsh l2 (- s 16)))
  180.                               (+ (lsh m2 s) (lsh l2 (- s 16))))))
  181.           (l3 (logand 65535 (if (> s 15)
  182.                                 (+ (lsh l2 (- s 32)) (lsh m2 (- s 16)))
  183.                               (+ (lsh l2 s) (lsh m2 (- s 16)))))))
  184.        (md5-add (cons m3 l3) b)))))
  185.  
  186. (md5-make-step md5-FF md5-F)
  187. (md5-make-step md5-GG md5-G)
  188. (md5-make-step md5-HH md5-H)
  189. (md5-make-step md5-II md5-I)
  190.  
  191. (defun md5-init ()
  192.   "Initialise the state of the message-digest routines."
  193.   (aset md5-bits 0 0)
  194.   (aset md5-bits 1 0)
  195.   (aset md5-bits 2 0)
  196.   (aset md5-bits 3 0)
  197.   (aset md5-buffer 0 '(26437 .  8961))
  198.   (aset md5-buffer 1 '(61389 . 43913))
  199.   (aset md5-buffer 2 '(39098 . 56574))
  200.   (aset md5-buffer 3 '( 4146 . 21622)))
  201.  
  202. (defun md5-update (string)
  203.   "Update the current MD5 state with STRING (an array of bytes)."
  204.   (let ((len (length string))
  205.         (i 0)
  206.         (j 0))
  207.     (while (< i len)
  208.       ;; Compute number of bytes modulo 64
  209.       (setq j (% (/ (aref md5-bits 0) 8) 64))
  210.  
  211.       ;; Store this byte (truncating to 8 bits to be sure)
  212.       (aset md5-input j (logand 255 (aref string i)))
  213.  
  214.       ;; Update number of bits by 8 (modulo 2^64)
  215.       (let ((c 8) (k 0))
  216.         (while (and (> c 0) (< k 4))
  217.           (let ((b (aref md5-bits k)))
  218.             (aset md5-bits k (logand 65535 (+ b c)))
  219.             (setq c (if (> b (- 65535 c)) 1 0)
  220.                   k (1+ k)))))
  221.  
  222.       ;; Increment number of bytes processed
  223.       (setq i (1+ i))
  224.  
  225.       ;; When 64 bytes accumulated, pack them into sixteen 32-bit
  226.       ;; integers in the array `in' and then tranform them.
  227.       (if (= j 63)
  228.           (let ((in (make-vector 16 (cons 0 0)))
  229.                 (k 0)
  230.                 (kk 0))
  231.             (while (< k 16)
  232.               (aset in k (md5-pack md5-input kk))
  233.               (setq k (+ k 1) kk (+ kk 4)))
  234.             (md5-transform in))))))
  235.  
  236. (defun md5-pack (array i)
  237.   "Pack the four bytes at ARRAY reference I to I+3 into a 32-bit integer."
  238.   (cons (+ (lsh (aref array (+ i 3)) 8) (aref array (+ i 2)))
  239.         (+ (lsh (aref array (+ i 1)) 8) (aref array (+ i 0)))))
  240.  
  241. (defun md5-byte (array n b)
  242.   "Unpack byte B (0 to 3) from Nth member of ARRAY of 32-bit integers."
  243.   (let ((e (aref array n)))
  244.     (cond ((eq b 0) (logand 255 (cdr e)))
  245.           ((eq b 1) (lsh (cdr e) -8))
  246.           ((eq b 2) (logand 255 (car e)))
  247.           ((eq b 3) (lsh (car e) -8)))))
  248.  
  249. (defun md5-final ()
  250.   (let ((in (make-vector 16 (cons 0 0)))
  251.         (j 0)
  252.         (digest (make-vector 16 0))
  253.         (padding))
  254.  
  255.     ;; Save the number of bits in the message
  256.     (aset in 14 (cons (aref md5-bits 1) (aref md5-bits 0)))
  257.     (aset in 15 (cons (aref md5-bits 3) (aref md5-bits 2)))
  258.  
  259.     ;; Compute number of bytes modulo 64
  260.     (setq j (% (/ (aref md5-bits 0) 8) 64))
  261.  
  262.     ;; Pad out computation to 56 bytes modulo 64
  263.     (setq padding (make-vector (if (< j 56) (- 56 j) (- 120 j)) 0))
  264.     (aset padding 0 128)
  265.     (md5-update padding)
  266.  
  267.     ;; Append length in bits and transform
  268.     (let ((k 0) (kk 0))
  269.       (while (< k 14)
  270.         (aset in k (md5-pack md5-input kk))
  271.         (setq k (+ k 1) kk (+ kk 4))))
  272.     (md5-transform in)
  273.  
  274.     ;; Store the results in the digest
  275.     (let ((k 0) (kk 0))
  276.       (while (< k 4)
  277.         (aset digest (+ kk 0) (md5-byte md5-buffer k 0))
  278.         (aset digest (+ kk 1) (md5-byte md5-buffer k 1))
  279.         (aset digest (+ kk 2) (md5-byte md5-buffer k 2))
  280.         (aset digest (+ kk 3) (md5-byte md5-buffer k 3))
  281.         (setq k (+ k 1) kk (+ kk 4))))
  282.  
  283.     ;; Return digest
  284.     digest))
  285.  
  286. ;; It says in the RSA source, "Note that if the Mysterious Constants are
  287. ;; arranged backwards in little-endian order and decrypted with the DES
  288. ;; they produce OCCULT MESSAGES!"  Security through obscurity?
  289.  
  290. (defun md5-transform (in)
  291.   "Basic MD5 step. Transform md5-buffer based on array IN."
  292.   (let ((a (aref md5-buffer 0))
  293.         (b (aref md5-buffer 1))
  294.         (c (aref md5-buffer 2))
  295.         (d (aref md5-buffer 3)))
  296.     (setq
  297.      a (md5-FF a b c d (aref in  0)  7 '(55146 . 42104))
  298.      d (md5-FF d a b c (aref in  1) 12 '(59591 . 46934))
  299.      c (md5-FF c d a b (aref in  2) 17 '( 9248 . 28891))
  300.      b (md5-FF b c d a (aref in  3) 22 '(49597 . 52974))
  301.      a (md5-FF a b c d (aref in  4)  7 '(62844 .  4015))
  302.      d (md5-FF d a b c (aref in  5) 12 '(18311 . 50730))
  303.      c (md5-FF c d a b (aref in  6) 17 '(43056 . 17939))
  304.      b (md5-FF b c d a (aref in  7) 22 '(64838 . 38145))
  305.      a (md5-FF a b c d (aref in  8)  7 '(27008 . 39128))
  306.      d (md5-FF d a b c (aref in  9) 12 '(35652 . 63407))
  307.      c (md5-FF c d a b (aref in 10) 17 '(65535 . 23473))
  308.      b (md5-FF b c d a (aref in 11) 22 '(35164 . 55230))
  309.      a (md5-FF a b c d (aref in 12)  7 '(27536 .  4386))
  310.      d (md5-FF d a b c (aref in 13) 12 '(64920 . 29075))
  311.      c (md5-FF c d a b (aref in 14) 17 '(42617 . 17294))
  312.      b (md5-FF b c d a (aref in 15) 22 '(18868 .  2081))
  313.      a (md5-GG a b c d (aref in  1)  5 '(63006 .  9570))
  314.      d (md5-GG d a b c (aref in  6)  9 '(49216 . 45888))
  315.      c (md5-GG c d a b (aref in 11) 14 '( 9822 . 23121))
  316.      b (md5-GG b c d a (aref in  0) 20 '(59830 . 51114))
  317.      a (md5-GG a b c d (aref in  5)  5 '(54831 .  4189))
  318.      d (md5-GG d a b c (aref in 10)  9 '(  580 .  5203))
  319.      c (md5-GG c d a b (aref in 15) 14 '(55457 . 59009))
  320.      b (md5-GG b c d a (aref in  4) 20 '(59347 . 64456))
  321.      a (md5-GG a b c d (aref in  9)  5 '( 8673 . 52710))
  322.      d (md5-GG d a b c (aref in 14)  9 '(49975 .  2006))
  323.      c (md5-GG c d a b (aref in  3) 14 '(62677 .  3463))
  324.      b (md5-GG b c d a (aref in  8) 20 '(17754 .  5357))
  325.      a (md5-GG a b c d (aref in 13)  5 '(43491 . 59653))
  326.      d (md5-GG d a b c (aref in  2)  9 '(64751 . 41976))
  327.      c (md5-GG c d a b (aref in  7) 14 '(26479 .   729))
  328.      b (md5-GG b c d a (aref in 12) 20 '(36138 . 19594))
  329.      a (md5-HH a b c d (aref in  5)  4 '(65530 . 14658))
  330.      d (md5-HH d a b c (aref in  8) 11 '(34673 . 63105))
  331.      c (md5-HH c d a b (aref in 11) 16 '(28061 . 24866))
  332.      b (md5-HH b c d a (aref in 14) 23 '(64997 . 14348))
  333.      a (md5-HH a b c d (aref in  1)  4 '(42174 . 59972))
  334.      d (md5-HH d a b c (aref in  4) 11 '(19422 . 53161))
  335.      c (md5-HH c d a b (aref in  7) 16 '(63163 . 19296))
  336.      b (md5-HH b c d a (aref in 10) 23 '(48831 . 48240))
  337.      a (md5-HH a b c d (aref in 13)  4 '(10395 . 32454))
  338.      d (md5-HH d a b c (aref in  0) 11 '(60065 . 10234))
  339.      c (md5-HH c d a b (aref in  3) 16 '(54511 . 12421))
  340.      b (md5-HH b c d a (aref in  6) 23 '( 1160 .  7429))
  341.      a (md5-HH a b c d (aref in  9)  4 '(55764 . 53305))
  342.      d (md5-HH d a b c (aref in 12) 11 '(59099 . 39397))
  343.      c (md5-HH c d a b (aref in 15) 16 '( 8098 . 31992))
  344.      b (md5-HH b c d a (aref in  2) 23 '(50348 . 22117))
  345.      a (md5-II a b c d (aref in  0)  6 '(62505 .  8772))
  346.      d (md5-II d a b c (aref in  7) 10 '(17194 . 65431))
  347.      c (md5-II c d a b (aref in 14) 15 '(43924 .  9127))
  348.      b (md5-II b c d a (aref in  5) 21 '(64659 . 41017))
  349.      a (md5-II a b c d (aref in 12)  6 '(25947 . 22979))
  350.      d (md5-II d a b c (aref in  3) 10 '(36620 . 52370))
  351.      c (md5-II c d a b (aref in 10) 15 '(65519 . 62589))
  352.      b (md5-II b c d a (aref in  1) 21 '(34180 . 24017))
  353.      a (md5-II a b c d (aref in  8)  6 '(28584 . 32335))
  354.      d (md5-II d a b c (aref in 15) 10 '(65068 . 59104))
  355.      c (md5-II c d a b (aref in  6) 15 '(41729 . 17172))
  356.      b (md5-II b c d a (aref in 13) 21 '(19976 .  4513))
  357.      a (md5-II a b c d (aref in  4)  6 '(63315 . 32386))
  358.      d (md5-II d a b c (aref in 11) 10 '(48442 . 62005))
  359.      c (md5-II c d a b (aref in  2) 15 '(10967 . 53947))
  360.      b (md5-II b c d a (aref in  9) 21 '(60294 . 54161)))
  361.  
  362.      (aset md5-buffer 0 (md5-add (aref md5-buffer 0) a))
  363.      (aset md5-buffer 1 (md5-add (aref md5-buffer 1) b))
  364.      (aset md5-buffer 2 (md5-add (aref md5-buffer 2) c))
  365.      (aset md5-buffer 3 (md5-add (aref md5-buffer 3) d))))
  366.  
  367. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  368. ;;; Here begins the merger with the XEmacs API and the md5.el from the URL
  369. ;;; package.  Courtesy wmperry@cs.indiana.edu
  370. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  371. (defun md5 (object &optional start end)
  372.   "Return the MD5 (a secure message digest algorithm) of an object.
  373. OBJECT is either a string or a buffer.
  374. Optional arguments START and END denote buffer positions for computing the
  375. hash of a portion of OBJECT."
  376.  (let ((buffer nil))
  377.     (unwind-protect
  378.     (save-excursion
  379.       (setq buffer (generate-new-buffer " *md5-work*"))
  380.       (set-buffer buffer)
  381.       (cond
  382.        ((bufferp object)
  383.         (insert-buffer-substring object start end))
  384.        ((stringp object)
  385.         (insert (if (or start end)
  386.             (substring object start end)
  387.               object)))
  388.        (t nil))
  389.       (prog1
  390.           (if (<= (point-max) md5-maximum-internal-length)
  391.           (mapconcat
  392.            (function (lambda (node) (format "%02x" node)))
  393.            (md5-encode (buffer-string))
  394.            "")
  395.         (call-process-region (point-min) (point-max)
  396.                      shell-file-name
  397.                      t buffer nil
  398.                      shell-command-switch md5-program)
  399.         ;; MD5 digest is 32 chars long
  400.         ;; mddriver adds a newline to make neaten output for tty
  401.         ;; viewing, make sure we leave it behind.
  402.         (buffer-substring (point-min) (+ (point-min) 32)))
  403.         (kill-buffer buffer)))
  404.       (and buffer (buffer-name buffer) (kill-buffer buffer) nil))))
  405.  
  406. (provide 'md5)
  407.